home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
351-375
/
disk_358
/
ops5c
/
ops5c.lzh
/
OPS5c
/
test_files
/
waltz.ops
< prev
Wrap
Text File
|
1988-12-09
|
12KB
|
403 lines
;and the RHS actions that
;are user defined
;Our WM elements. Lines have the lable line followed by the 2 points
;defining the line. Edges are like lines accept that they can be labeled,
;permanently labelled and plotted. Junctions are defined by 4 points. The
;basepoint is where the 3 (2) lines intersect. The points p1, p2, p3 are the
;other endpoints of the lines at this junction
(literalize stage value)
(literalize line p1 p2)
(literalize edge p1 p2 joined label plotted)
(literalize junction p1 p2 p3 base_point type)
;The Waltz Algorithm using OPS5 Production System Interpreter
;This is our production memory
;Our starting production. It checks to see if the start flag is in WM,
;and if it is, it deletes it, and clears the screen
(p begin
(stage ^value start)
-->
; (write clr)
(make line ^p1 0122 ^p2 0107)
(make line ^p1 0107 ^p2 2207)
(make line ^p1 2207 ^p2 3204)
(make line ^p1 3204 ^p2 6404)
(make line ^p1 2216 ^p2 2207)
(make line ^p1 3213 ^p2 3204)
(make line ^p1 2216 ^p2 3213)
(make line ^p1 0107 ^p2 2601)
(make line ^p1 2601 ^p2 7401)
(make line ^p1 6404 ^p2 7401)
(make line ^p1 3213 ^p2 6413)
(make line ^p1 6413 ^p2 6404)
(make line ^p1 7416 ^p2 7401)
(make line ^p1 5216 ^p2 6413)
(make line ^p1 2216 ^p2 5216)
(make line ^p1 0122 ^p2 5222)
(make line ^p1 5222 ^p2 7416)
(make line ^p1 5222 ^p2 5216)
(modify 1 ^value duplicate))
;If the duplicate flag is set, and there is still a line in WM, delete the line
;and add two edges. One edge runs from p1 to p2 and the other runs from p2 to
;p1. We then plot the edge.
(p reverse_edges
(stage ^value duplicate)
(line ^p1 <p1> ^p2 <p2>)
-->
; (write draw <p1> <p2> (crlf))
(make edge ^p1 <p1> ^p2 <p2> ^joined false)
(make edge ^p1 <p2> ^p2 <p1> ^joined false)
(remove 2))
;If the duplicating flag is set, and there are no more lines, then remove the
;duplicating flag and set the make junctions flag.
(p done_reversing
(stage ^value duplicate)
- (line)
-->
(modify 1 ^value detect_junctions))
;If three edges meet at a point and none of them have already been joined in
;a junction, then make the corresponding type of junction and label the
;edges joined. This production calls make-3_junction to determine
;what type of junction it is based on the angles inscribed by the
;intersecting edges
(p make-3_junction
(stage ^value detect_junctions)
(edge ^p1 <base_point> ^p2 <p1> ^joined false)
(edge ^p1 <base_point> ^p2 {<p2> <> <p1>} ^joined false)
(edge ^p1 <base_point> ^p2 {<p3> <> <p1> <> <p2>} ^joined false)
-->
(make junction
^type (make_3_junction <base_point> <p1> <p2> <p3>)
^base_point <base_point>)
(modify 2 ^joined true)
(modify 3 ^joined true)
(modify 4 ^joined true))
;If two, and only two, edges meet that have not already been joined, then
;the junction is an "L"
(p make_L
(stage ^value detect_junctions)
(edge ^p1 <base_point> ^p2 <p2> ^joined false)
(edge ^p1 <base_point> ^p2 {<p3> <> <p2>} ^joined false)
- (edge ^p1 <base_point> ^p2 {<> <p2> <> <p3>})
-->
(make junction
^type L
^base_point <base_point>
^p1 <p2>
^p2 <p3>)
(modify 2 ^joined true)
(modify 3 ^joined true))
;If the detect junctions flag is set, and there are no more un_joined edges,
;set the find_initial_boundary flag
(p done_detecting
(stage ^value detect_junctions)
- (edge ^joined false)
-->
(modify 1 ^value find_initial_boundary))
;If the initial boundary junction is an L, then we know it's labelling
(p initial_boundary_junction_L
(stage ^value find_initial_boundary)
(junction ^type L ^base_point <base_point> ^p1 <p1> ^p2 <p2>)
(edge ^p1 <base_point> ^p2 <p1>)
(edge ^p1 <base_point> ^p2 <p2>)
- (junction ^base_point > <base_point>)
-->
(modify 3 ^label B)
(modify 4 ^label B)
(modify 1 ^value find_second_boundary))
;Ditto for an arrow
(p initial_boundary_junction_arrow
(stage ^value find_initial_boundary)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p1>)
(edge ^p1 <bp> ^p2 <p2>)
(edge ^p1 <bp> ^p2 <p3>)
- (junction ^base_point > <bp>)
-->
(modify 3 ^label B)
(modify 4 ^label +)
(modify 5 ^label B)
(modify 1 ^value find_second_boundary))
;If we have already found the first boundary point, then find the second
;boundary point, and label it.
(p second_boundary_junction_L
(stage ^value find_second_boundary)
(junction ^type L ^base_point <base_point> ^p1 <p1> ^p2 <p2>)
(edge ^p1 <base_point> ^p2 <p1>)
(edge ^p1 <base_point> ^p2 <p2>)
- (junction ^base_point < <base_point>)
-->
(modify 3 ^label B)
(modify 4 ^label B)
(modify 1 ^value labeling))
(p second_boundary_junction_arrow
(stage ^value find_second_boundary)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p1>)
(edge ^p1 <bp> ^p2 <p2>)
(edge ^p1 <bp> ^p2 <p3>)
- (junction ^base_point < <bp>)
-->
(modify 3 ^label B)
(modify 4 ^label +)
(modify 5 ^label B)
(modify 1 ^value labeling))
;If we have an edge whose label we already know definitely, then
;label the corresponding edge in the other direction
(p match_edge
(stage ^value labeling)
(edge ^p1 <p1> ^p2 <p2> ^label {<label> << + - B >>})
(edge ^p1 <p2> ^p2 <p1> ^label nil)
-->
(modify 2 ^plotted t)
(modify 3 ^label <label> ^plotted t)
; (write plot <label> <p1> <p2> (crlf))
)
;The following productions propogate the possible labellings of the edges
;based on the labellings of edges incident on adjacent junctions. Since
;from the initial boundary productions, we have determined the labellings of
;of atleast two junctions, this propogation will label all of the junctions
;with the possible labellings. The search space is pruned due to filtering,
;i.e. - only label a junction in the ways physically possible based on the
;labellings of adjacent junctions.
(p label_L
(stage ^value labeling)
(junction ^type L ^base_point <p1>)
(edge ^p1 <p1> ^p2 <p2> ^label << + - >>)
(edge ^p1 <p1> ^p2 <> <p2> ^label nil)
-->
(modify 4 ^label B))
(p label_tee_A
(stage ^value labeling)
(junction ^type tee ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p1> ^label nil)
(edge ^p1 <bp> ^p2 <p3>)
-->
(modify 3 ^label B)
(modify 4 ^label B))
(p label_tee_B
(stage ^value labeling)
(junction ^type tee ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p1>)
(edge ^p1 <bp> ^p2 <p3> ^label nil)
-->
(modify 3 ^label B)
(modify 4 ^label B))
(p label_fork-1
(stage ^value labeling)
(junction ^type fork ^base_point <bp>)
(edge ^p1 <bp> ^p2 <p1> ^label +)
(edge ^p1 <bp> ^p2 {<p2> <> <p1>} ^label nil)
(edge ^p1 <bp> ^p2 {<> <p2> <> <p1>})
-->
(modify 4 ^label +)
(modify 5 ^label +))
(p label_fork-2
(stage ^value labeling)
(junction ^type fork ^base_point <bp>)
(edge ^p1 <bp> ^p2 <p1> ^label B)
(edge ^p1 <bp> ^p2 {<p2> <> <p1>} ^label -)
(edge ^p1 <bp> ^p2 {<> <p2> <> <p1>} ^label nil)
-->
(modify 5 ^label B))
(p label_fork-3
(stage ^value labeling)
(junction ^type fork ^base_point <bp>)
(edge ^p1 <bp> ^p2 <p1> ^label B)
(edge ^p1 <bp> ^p2 {<p2> <> <p1>} ^label B)
(edge ^p1 <bp> ^p2 {<> <p2> <> <p1>} ^label nil)
-->
(modify 5 ^label -))
(p label_fork-4
(stage ^value labeling)
(junction ^type fork ^base_point <bp>)
(edge ^p1 <bp> ^p2 <p1> ^label -)
(edge ^p1 <bp> ^p2 {<p2> <> <p1>} ^label -)
(edge ^p1 <bp> ^p2 {<> <p2> <> <p1>} ^label nil)
-->
(modify 5 ^label -))
(p label_arrow-1A
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p1> ^label {<label> << B - >>})
(edge ^p1 <bp> ^p2 <p2> ^label nil)
(edge ^p1 <bp> ^p2 <p3>)
-->
(modify 4 ^label +)
(modify 5 ^label <label>))
(p label_arrow-1B
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p1> ^label {<label> << B - >>})
(edge ^p1 <bp> ^p2 <p2>)
(edge ^p1 <bp> ^p2 <p3> ^label nil)
-->
(modify 4 ^label +)
(modify 5 ^label <label>))
(p label_arrow-2A
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p3> ^label {<label> << B - >>})
(edge ^p1 <bp> ^p2 <p2> ^label nil)
(edge ^p1 <bp> ^p2 <p1>)
-->
(modify 4 ^label +)
(modify 5 ^label <label>))
(p label_arrow-2B
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p3> ^label {<label> << B - >>})
(edge ^p1 <bp> ^p2 <p2>)
(edge ^p1 <bp> ^p2 <p1> ^label nil)
-->
(modify 4 ^label +)
(modify 5 ^label <label>))
(p label_arrow-3A
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p1> ^label +)
(edge ^p1 <bp> ^p2 <p2> ^label nil)
(edge ^p1 <bp> ^p2 <p3>)
-->
(modify 4 ^label -)
(modify 5 ^label +))
(p label_arrow-3B
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p1> ^label +)
(edge ^p1 <bp> ^p2 <p2>)
(edge ^p1 <bp> ^p2 <p3> ^label nil)
-->
(modify 4 ^label -)
(modify 5 ^label +))
(p label_arrow-4A
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p3> ^label +)
(edge ^p1 <bp> ^p2 <p2> ^label nil)
(edge ^p1 <bp> ^p2 <p1>)
-->
(modify 4 ^label -)
(modify 5 ^label +))
(p label_arrow-4B
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p3> ^label +)
(edge ^p1 <bp> ^p2 <p2>)
(edge ^p1 <bp> ^p2 <p1> ^label nil)
-->
(modify 4 ^label -)
(modify 5 ^label +))
(p label_arrow-5A
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p2> ^label -)
(edge ^p1 <bp> ^p2 <p1>)
(edge ^p1 <bp> ^p2 <p3> ^label nil)
-->
(modify 4 ^label +)
(modify 5 ^label +))
(p label_arrow-5B
(stage ^value labeling)
(junction ^type arrow ^base_point <bp> ^p1 <p1> ^p2 <p2> ^p3 <p3>)
(edge ^p1 <bp> ^p2 <p2> ^label -)
(edge ^p1 <bp> ^p2 <p1> ^label nil)
(edge ^p1 <bp> ^p2 <p3>)
-->
(modify 4 ^label +)
(modify 5 ^label +))
;The conflict resolution mechanism will onle execute a production if no
;productions that are more complicated are satisfied. This production is
;simple, so all of the above dictionary productions will fire before this
;change of state production
(p done_labeling
(stage ^value labeling)
-->
(modify 1 ^value plot_remaining_edges))
;At this point, some labellings may have not been plotted, so plot them
(p plot_remaining
(stage ^value plot_remaining_edges)
(edge ^plotted nil ^label {<label> <> nil} ^p1 <p1> ^p2 <p2>)
-->
; (write plot <label> <p1> <p2> (crlf))
(modify 2 ^plotted t))
;If we have been un able to label an edge, assume that it is a boundary.
;This is a total Kludge, but what the hell. (if we assume only valid drawings
;will be given for labeling, this assumption generally is true!)
(p plot_boundaries
(stage ^value plot_remaining_edges)
(edge ^plotted nil ^label nil ^p1 <p1> ^p2 <p2>)
-->
; (write plot B <p1> <p2> (crlf))
(modify 2 ^plotted t))
;If there is no more work to do, then we are done and flag it.
(p done_plotting
(stage ^value plot_remaining_edges)
- (edge ^plotted nil)
-->
(modify 1 ^value done))
;Prompt the user as to where he can see a trace of the OPS5
;execution
(p done
(stage ^value done)
-->
; (write see trace.waltz for description of execution- hit CR to end (crlf))
(halt))